home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / texread.ss < prev   
Text File  |  1993-11-07  |  6KB  |  189 lines
  1. ;texread.ss
  2. ;SLaTeX Version 1.99
  3. ;Various token-readers used on TeX files by SLaTeX
  4. ;(c) Dorai Sitaram, December 1991, Rice University
  5.  
  6. (define read-ctrl-seq
  7.   (lambda (in)
  8.     ;assuming we've just read a backslash, read the remaining
  9.     ;part of a latex control sequence from port in
  10.     (let ((c (read-char in)))
  11.       (if (eof-object? c) (lerror 'read-ctrl-exp))
  12.       (if (char-alphabetic? c)
  13.       (list->string
  14.         (reverse! 
  15.           (let loop ((s (list c)))
  16.         (let ((c (peek-char in)))
  17.           (cond ((eof-object? c) s)
  18.             ((char-alphabetic? c) (read-char in)
  19.              (loop (cons c s)))
  20.             ((char=? c #\%) (eat-till-newline in) 
  21.              (loop s))
  22.             (else s))))))
  23.       (string c)))))
  24.  
  25. (define eat-till-newline
  26.   (lambda (in)
  27.     ;skip all characters from port in till newline inclusive or eof
  28.     (let loop ()
  29.       (let ((c (read-char in)))
  30.     (cond ((eof-object? c) 'done)
  31.           ((char=? c #\newline) 'done)
  32.           (else (loop)))))))
  33.  
  34. (define eat-tabspace
  35.   (lambda (in)
  36.     ;skip to the next non-space and non-tab character from port in
  37.     (let loop ()
  38.       (let ((c (peek-char in)))
  39.     (cond ((eof-object? c) 'done)
  40.           ((or (char=? c #\space) (char=? c #\tab))
  41.            (read-char in) (loop))
  42.           (else 'done))))))
  43.  
  44. (define eat-whitespace
  45.   (lambda (in)
  46.     ;skip to the next whitespace character from port in
  47.     (let loop ()
  48.       (let ((c (peek-char in)))
  49.     (cond ((eof-object? c) 'done)
  50.           ((char-whitespace? c)
  51.            (read-char in) (loop))
  52.           (else 'done))))))
  53.  
  54. (define eat-latex-whitespace
  55.   (lambda (in)
  56.     ;skip to the next whitespace character from port in;
  57.     ;skips past latex comments too 
  58.     (let loop ()
  59.       (let ((c (peek-char in)))
  60.     (cond ((eof-object? c) 'done)
  61.           ((char-whitespace? c) (read-char in) (loop))
  62.           ((char=? c #\%) (eat-till-newline in))
  63.           (else 'done))))))
  64.  
  65. (define chop-off-whitespace
  66.   (lambda (l)
  67.     ;removes leading whitespace from character-list l
  68.     (ormapcdr (lambda (d) (if (char-whitespace? (car d)) #f d)) l)))
  69.  
  70. (define read-grouped-latexexp
  71.   (lambda (in)
  72.     ;reads a latex grouped expression from port in
  73.     ;(removes the groups)
  74.     (eat-latex-whitespace in)
  75.     (let ((c (read-char in)))
  76.       (if (eof-object? c) (lerror 'read-grouped-latexexp 1))
  77.       (if (char=? c #\{) 'ok (lerror 'read-grouped-latexexp 2))
  78.       (eat-latex-whitespace in)
  79.       (list->string
  80.     (reverse!
  81.       (chop-off-whitespace
  82.         (let loop ((s '()) (nesting 0) (escape? #f))
  83.           (let ((c (read-char in)))
  84.         (if (eof-object? c) (lerror 'read-grouped-latexexp 3))
  85.         (cond (escape? (loop (cons c s) nesting #f))
  86.               ((char=? c #\\) 
  87.                (loop (cons c s) nesting #t))
  88.               ((char=? c #\%) (eat-till-newline in)
  89.                (loop s nesting #f))
  90.               ((char=? c #\{) 
  91.                (loop (cons c s) (+ nesting 1) #f))
  92.               ((char=? c #\})
  93.                (if (= nesting 0) s
  94.              (loop (cons c s) (- nesting 1) #f)))
  95.               (else
  96.             (loop (cons c s) nesting #f)))))))))))
  97.  
  98. (define read-filename
  99.   (let ((filename-delims (list #\{ #\} #\[ #\] #\( #\) #\# #\% #\\ #\, 
  100.                #\space #\newline #\tab)))
  101.     (lambda (in)
  102.       ;reads a filename as allowed in latex syntax from port in
  103.       (eat-latex-whitespace in)
  104.       (let ((c (peek-char in)))
  105.     (if (eof-object? c) (lerror 'read-filename 1))
  106.     (if (char=? c #\{) (read-grouped-latexexp in)
  107.       (list->string
  108.         (reverse!
  109.           (let loop ((s '()) (escape? #f))
  110.         (let ((c (peek-char in)))
  111.           (cond ((eof-object? c)
  112.              (if escape? (lerror 'read-filename 2) s))
  113.             (escape? (read-char in)
  114.               (loop (cons c s) #f))
  115.             ((char=? c #\\) (read-char in)
  116.              (loop (cons c s) #t))
  117.             ((memv c filename-delims) s)
  118.             (else (read-char in)
  119.                    (loop (cons c s) #f))))))))))))
  120.  
  121. (define read-schemeid
  122.   (let ((schemeid-delims (list #\{ #\} #\[ #\] #\( #\) 
  123.                #\space #\newline #\tab))) 
  124.     (lambda (in)
  125.       ;reads a scheme identifier from port in
  126.       (eat-whitespace in)
  127.       (list->string
  128.     (reverse!
  129.       (let loop ((s '()) (escape? #f))
  130.         (let ((c (peek-char in)))
  131.           (cond ((eof-object? c) s)
  132.             (escape? (read-char in) (loop (cons c s) #f))
  133.             ((char=? c #\\) (read-char in)
  134.              (loop (cons c s) #t))
  135.             ((memv c schemeid-delims) s)
  136.             (else (read-char in) (loop (cons c s) #f))))))))))
  137.  
  138. (define read-delimed-commaed-filenames
  139.   (lambda (in lft-delim rt-delim)
  140.     ;reads a filename from port in, assuming it's delimited by
  141.     ;lft- and rt-delims
  142.     (eat-latex-whitespace in)
  143.     (let ((c (read-char in)))
  144.       (if (eof-object? c) (lerror 'read-delimed-commaed-filenames 1))
  145.       (if (char=? c lft-delim) 'ok 
  146.       (lerror 'read-delimed-commaed-filenames 2))
  147.       (let loop ((s '()))
  148.     (eat-latex-whitespace in)
  149.     (let ((c (peek-char in)))
  150.       (if (eof-object? c) (lerror 'read-delimed-commaed-filenames 3))
  151.       (if (char=? c rt-delim) 
  152.           (begin (read-char in) (reverse! s))
  153.           (let ((s (cons (read-filename in) s)))
  154.         (eat-latex-whitespace in)
  155.         (let ((c (peek-char in)))
  156.           (if (eof-object? c)
  157.             (lerror 'read-delimed-commaed-filenames 4))
  158.           (cond 
  159.             ((char=? c #\,) (read-char in))
  160.             ((char=? c rt-delim) 'void)
  161.             (else (lerror 'read-delimed-commaed-filenames 5)))
  162.           (loop s)))))))))
  163.  
  164. (define read-grouped-commaed-filenames
  165.   (lambda (in)
  166.     ;read a filename from port in, assuming it's grouped
  167.     (read-delimed-commaed-filenames in #\{ #\})))
  168.  
  169. (define read-bktd-commaed-filenames
  170.   (lambda (in)
  171.     ;read a filename from port in, assuming it's bracketed
  172.     (read-delimed-commaed-filenames in #\[ #\])))
  173.  
  174. (define read-grouped-schemeids
  175.   (lambda (in)
  176.     ;read a list of scheme identifiers from port in,
  177.     ;assuming they're all grouped
  178.     (eat-latex-whitespace in)
  179.     (let ((c (read-char in)))
  180.       (if (eof-object? c) (lerror 'read-grouped-schemeids 1))
  181.       (if (char=? c #\{) 'ok (lerror 'read-grouped-schemeids 2))
  182.       (let loop ((s '()))
  183.     (eat-whitespace in)
  184.     (let ((c (peek-char in)))
  185.       (if (eof-object? c) (lerror 'read-grouped-schemeids 3))
  186.       (if (char=? c #\})
  187.           (begin (read-char in) (reverse! s))
  188.           (loop (cons (read-schemeid in) s))))))))
  189.